home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 196_01 / bit78031.for < prev    next >
Text File  |  1985-11-13  |  4KB  |  100 lines
  1. C [BIT78031.FOR of JUGPDS Vol.19]
  2. Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  3. C                                                                             c
  4. C   An awarded program of a contest (Japan Student Association of Computers)  c
  5. C      by kihira shuu?                                                        c
  6. C                                                                 c    
  7. C     transerred from BIT 1978-04(Vol.10,No.4), p86-87                  c    
  8. C     by Toshiya Ohta & Studio Gala, June 11, 1985                  c
  9. C                                                                             c
  10. C                                                                             c
  11. Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  12. C
  13.       dimension m(4),a(4),m1(24),m2(24),m3(24),m4(24)
  14.       data a/1h+,1h*,1h-,1h//
  15.  
  16.       m(1) = 1
  17.       m(2) = 2
  18.       m(3) = 6
  19.       m(4) = 9
  20.       n = 0
  21.       do 10 i=1,4
  22.           do 10 j=1,4
  23.                do 10 k=1,4
  24.                     do 10 l=1,4
  25.                         if ((i-j)*(i-k)*(i-l)*(j-k)*(j-l)*(k-l)) 15,10,15
  26.    15                    n = n+1
  27.                          m1(n) = m(i)
  28.                          m2(n) = m(j)
  29.                          m3(n) = m(k)
  30.                          m4(n) = m(l)
  31.    10 continue
  32.       do 20 n=1,24
  33.           do 30 i=1,4
  34.               if (i-2) 301,301,302
  35.   301          if (m1(n)-m2(n)) 302,30,30
  36.   302          call sub(i,mm,m1(n),m2(n),isw)
  37.                if (isw) 30,303,30
  38.   303          do 35 j=1,4
  39.                    if (i-j) 353,351,353
  40.   351              if (i-2) 352,352,353
  41.   352              if (m2(n)-m3(n)) 353,35,35
  42.   353              call sub(j,nn,mm,m3(n),isw)
  43.                    if (isw) 35,355,35
  44.   355              do 135 k=1,4
  45.                         if (j-k) 358,356,358
  46.   356                   if (j-2) 357,357,358
  47.   357                   if (m3(n)-m4(n)) 358,135,135
  48.   358                   call sub(k,kk,nn,m4(n),isw)
  49.                         if (isw) 135,359,135
  50.   359                   if ((kk-70)*(kk-90)) 360,360,135
  51.   360                   write(1,600) kk,m1(n),a(i),m2(n),a(j),m3(n),
  52.      +                               a(k),m4(n)
  53.   600                   format(1h ,i2,3h=((,i2,a1,i2,1h),a1,i2,1h),
  54.      +                         a1,i2)
  55.   135               continue
  56.    35          continue
  57.                do 40 k=i,4
  58.                    if (i-k) 403,401,403
  59.   401              if (i-2) 402,402,403
  60.   402              if (m1(n)-m3(n)) 403,40,40
  61.   403              if (k-2) 404,404,405
  62.   404              if (m3(n)-m4(n)) 405,40,40
  63.   405              call sub(k,nn,m3(n),m4(n),isw)
  64.                    if (isw) 40,410,40
  65.   410              do 140 j=1,4
  66.                         if (i-j) 412,411,412
  67.   411                   if (i-2) 140,140,412
  68.   412                   if (j-k) 414,413,414
  69.   413                   if (j-2) 140,140,414
  70.   414                   call sub(j,kk,mm,nn,isw)
  71.                         if (isw) 140,415,140
  72.   415                   if ((kk-70)*(kk-90)) 416,416,140
  73.   416                   write(1,610) kk,m1(n),a(i),m2(n),a(j),m3(n),
  74.      +                               a(k),m4(n)
  75.   610                   format(1h ,i2,2h=(,i2,a1,i2,1h),a1,1h(,i2,
  76.      +                         a1,i2,1h))
  77.   140               continue
  78.    40          continue
  79.    30     continue
  80.    20 continue
  81.       stop
  82.       end
  83. C
  84. C
  85.       subroutine sub(ii,mc,ma,mb,isw)
  86.       isw = 0
  87.       goto (1,2,3,4), ii
  88.     1     mc = ma+mb
  89.       goto 7
  90.     2     mc = ma*mb
  91.       goto 7
  92.     3     mc = ma-mb
  93.       goto 7
  94.     4     if (ma-ma/mb*mb) 5,6,5
  95.     5          isw = 1
  96.           goto 7
  97.     6          mc = ma/mb
  98.     7 return
  99.       end
  100.